home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 081-090 / amok82 / plot / source / reqsupport.mod < prev    next >
Text File  |  1993-11-04  |  9KB  |  288 lines
  1. (* ReqSupport.mod   ported to M2Amiga 4.0 1991 by Jürgen Zimmermann  *)
  2. (*                  Hilfsroutinen der Oberon-Implementation          *)
  3. (* Req.mod          ported to Oberon 1990 by Achim Siebert           *)
  4. (* reqlibrary.h   © 1988/1989 reserved by Colin Fox and Bruce Dawson *)
  5. (* changed          16.10.92 by Stefan Koehle                          *)
  6.  
  7. (**********************************************************************
  8.  
  9.     :Program.    FileRequester.mod
  10.     :Contents.   Einfaches Interface zum FileRequester der "req.library"
  11.     :Author.     Jürgen Zimmermann [JnZ]
  12.     :Address.    Ringstraße 6, W-6719 Altleiningen, Germany
  13.     :Phone.      06356/1456
  14.     :Copyright.  Public Domain (but donation is always welcome!)
  15.     :Language.   Modula-2
  16.     :Translator. M2Amiga AMSoft V4.096d
  17.     :Imports.    Die Prozedur "GetPathFromLock" habe ich aus dem Modul
  18.     :Imports.    "Disky" von Kai Bolay entnommen und an die Anforderungen
  19.     :Imports.    in diesem Interface angepaßt.
  20.     :Imports.    Die "req.library" muß im Verzeichnis "LIBS:" stehen!
  21.     :History.    V1.0  [JnZ] 25.May.1991 first internal version which works
  22. **********************************************************************)
  23.  
  24.  
  25.  
  26.  
  27. IMPLEMENTATION MODULE ReqSupport;
  28.  
  29. IMPORT rd: ReqD,
  30.        rl: ReqL;
  31.  
  32. IMPORT Arts, DosD, DosL, DosSupport, ExecL, ExecD, IntuitionD,
  33.        String, SYSTEM, WorkbenchD;
  34. FROM Arts   IMPORT Terminate ;
  35. FROM SYSTEM IMPORT ADR,ADDRESS ;
  36. FROM InOut IMPORT WriteString,WriteLn ;
  37. FROM GraphicsD IMPORT ViewModes ;
  38.  
  39. VAR result: INTEGER ;
  40.  
  41.  
  42.  
  43.  
  44. PROCEDURE GetPathFromLock(VAR Path   : ARRAY OF CHAR;
  45.                           ThisLockPtr: DosD.FileLockPtr);
  46. (* von irgendeiner PD-Disk aus 'C' in Modula-II übersetzt (Autor ???) [kai]*)
  47.  
  48.  VAR CurDirPtr : DosD.FileLockPtr;
  49.      OldDirPtr : DosD.FileLockPtr;
  50.      VolumeLen : INTEGER;
  51.      FIBPtr    : DosD.FileInfoBlockPtr;
  52.  
  53.  BEGIN
  54.     Path[0]:=0C;
  55.     CurDirPtr:=DosSupport.DupLock(ThisLockPtr);
  56.     IF (CurDirPtr = NIL)
  57.        THEN
  58.           RETURN;
  59.     END; (* IF *)
  60.     FIBPtr := ExecL.AllocMem(SIZE(FIBPtr^),ExecD.MemReqSet{ExecD.memClear,
  61.                              ExecD.public}) ;
  62.     IF (FIBPtr # NIL)
  63.        THEN
  64.           ExecL.Forbid;
  65.           String.Copy(Path,CurDirPtr^.volume^.name^);
  66.           ExecL.Permit;
  67.           String.BStrToStr(Path);
  68.           String.Concat(Path,":");
  69.           VolumeLen:=String.Length(Path);
  70.           WHILE (CurDirPtr # NIL) DO
  71.              IF NOT(DosL.Examine(CurDirPtr,FIBPtr))
  72.                 THEN
  73.                    Path[0]:=0C;
  74.                    DosSupport.UnLock(CurDirPtr);
  75.                    CurDirPtr:=NIL;
  76.                 ELSE
  77.                    OldDirPtr:=CurDirPtr;
  78.                    CurDirPtr:=DosSupport.ParentDir(OldDirPtr);
  79.                    DosSupport.UnLock(OldDirPtr);
  80.                    IF (CurDirPtr # NIL)
  81.                       THEN
  82.                          IF (String.Length(Path) # VolumeLen)
  83.                             THEN
  84.                                String.Insert(Path,VolumeLen,"/");
  85.                          END; (* IF *)
  86.                          String.Insert(Path,VolumeLen,FIBPtr^.fileName);
  87.                    END; (* IF *)
  88.              END; (* IF *)
  89.           END; (* WHILE *)
  90.           ExecL.FreeMem(FIBPtr,SIZE(FIBPtr^)) ;
  91.     END; (* IF *)
  92.  END GetPathFromLock;
  93.  
  94.  
  95.  
  96. PROCEDURE FileRequest(RequesterWindow : IntuitionD.WindowPtr;
  97.                       load            : BOOLEAN; (* FALSE means saving *)
  98.                       getPath         : BOOLEAN;
  99.                       Title           : ARRAY OF CHAR;
  100.                       VAR FileNamePath,
  101.                           FileName    : ARRAY OF CHAR): BOOLEAN;
  102.  
  103.  VAR  freq      : rd.FileRequester;
  104.       dirstring : rd.DirString;
  105.       filestring: rd.FileString;
  106.       wholefile : rd.PathString;
  107.       pathPos   : LONGINT;
  108.       lock      : DosD.FileLockPtr;
  109.       msg       : WorkbenchD.WBStartupPtr;
  110.  
  111.  
  112.  BEGIN
  113.     IF (String.Length(FileNamePath) # 0) THEN
  114.        String.CopyPart(dirstring,FileNamePath,0,130) ;
  115.  
  116.     ELSIF getPath THEN
  117.          (* Arts unterstützt mich ab jetzt, d.h. ich setze den
  118.             Pfad im Path-Gadget genau auf den Pfad, der beim Start des
  119.             Programms vorgegeben ist: Dadurch kann man sich per "Parent"
  120.             bis zur obersten Ebene hindurchhangeln, nicht wie bei dem
  121.             Requester in "m2emacs"! *)
  122.        IF (Arts.wbStarted) THEN
  123.  
  124.           msg:=Arts.startupMsg;
  125.           lock:=msg^.argList^[0].lock;
  126.           IF (lock # NIL) THEN
  127.  
  128.               GetPathFromLock(dirstring,lock);
  129.           END; (* IF *)
  130.        ELSE
  131.  
  132.           GetPathFromLock(dirstring,Arts.oldCurrentDir);
  133.        END; (* IF *)
  134.     END; (* IF *)
  135.  
  136.     String.CopyPart(filestring,FileName,0,30) ;
  137.  
  138.     WITH freq DO
  139.        versionNumber    :=0;
  140.        title            :=SYSTEM.ADR(Title);
  141.        dir              :=SYSTEM.ADR(dirstring);
  142.        file             :=SYSTEM.ADR(filestring);
  143.        pathName         :=SYSTEM.ADR(wholefile);
  144.        flags            :=SYSTEM.LONGSET{rd.infogadget,rd.caching};
  145.        window           :=RequesterWindow;
  146.        maxExtendedSelect:=0;
  147.        numcolumns       :=30; (* Anzahl der angezeigten Zeichen der Files! *)
  148.        devcolumns       :=15;
  149.        flags            :=SYSTEM.LONGSET{};
  150.  
  151.        IF load
  152.           THEN
  153.              INCL(flags,rd.loading);
  154.           ELSE
  155.              INCL(flags,rd.saving);
  156.        END; (* IF *)
  157.  
  158.  
  159.        IF (RequesterWindow # NIL) AND        (* Eigener Screen mit 2 Farben *)
  160.           (RequesterWindow^.wScreen^.bitMap.depth < 2) THEN
  161.  
  162.           IF (lace IN RequesterWindow^.wScreen^.viewPort.modes) THEN
  163.              numlines         :=40; (* Anzahl der sichtbaren Files *)
  164.           ELSE
  165.              numlines         :=20;
  166.           END ;
  167.           dirnamescolor    :=1;   (* Farben fuer zweifarbigen Screen *)
  168.           devicenamescolor :=1;
  169.           detailcolor      :=0;
  170.           blockcolor       :=1;
  171.           gadgettextcolor  :=1;
  172.           textmessagecolor :=1;
  173.           stringnamecolor  :=1;
  174.           stringgadgetcolor:=1;
  175.           boxbordercolor   :=1;
  176.           gadgetboxcolor   :=1;
  177.        ELSE                   (* Workbenchscreen oder eigener mit mehr Farben *)
  178.           numlines         :=20; (* Anzahl der sichtbaren Files *)
  179.           dirnamescolor    :=3;
  180.           devicenamescolor :=2;
  181.           detailcolor      :=0;
  182.           blockcolor       :=1;
  183.           gadgettextcolor  :=1;
  184.           textmessagecolor :=3;
  185.           stringnamecolor  :=1;
  186.           stringgadgetcolor:=2;
  187.           boxbordercolor   :=3;
  188.           gadgetboxcolor   :=3;
  189.  
  190.        END ;
  191.  
  192.        windowLeftEdge   :=0;
  193.        windowTopEdge    :=0;
  194.        show             :="*";
  195.        hide             :="";
  196.     END; (* WITH *)
  197.  
  198.     IF rl.FileRequest(SYSTEM.ADR(freq)) THEN
  199.        IF String.Length(wholefile) # 0 THEN
  200.           pathPos := String.LastPos(wholefile,MAX(LONGCARD),"/") ;
  201.  
  202.           IF pathPos # String.noOccur THEN
  203.              String.CopyPart(FileNamePath,wholefile,0,pathPos) ;
  204.              String.CopyPart(FileName,wholefile,(pathPos+1),
  205.                              (String.Length(wholefile)-pathPos)) ;
  206.           ELSE
  207.              pathPos := String.LastPos(wholefile,MAX(LONGCARD),":") ;
  208.              IF pathPos # String.noOccur THEN
  209.                 String.CopyPart(FileNamePath,wholefile,0,pathPos+1) ;
  210.                 String.CopyPart(FileName,wholefile,(pathPos+1),
  211.                                 (String.Length(wholefile)-pathPos)) ;
  212.              ELSE
  213.                 String.Copy(FileName,wholefile) ;
  214.                 FileNamePath[0] := 0C ;
  215.              END ;
  216.  
  217.           END ;
  218.        END ;
  219.  
  220.        RETURN(TRUE);
  221.     ELSE
  222.        RETURN(FALSE);
  223.     END; (* IF *)
  224.  END FileRequest;
  225.  
  226.  
  227. PROCEDURE Request(header,body,posText,midText,negText: ADDRESS): INTEGER ;
  228.  
  229.    VAR textR : rd.TRStructure;
  230.  
  231.  BEGIN
  232.     textR.text          := body;                (* Text *)
  233.     textR.controls      := NIL;
  234.     textR.window        := NIL;
  235.     textR.middleText    := midText;             (* mitte *)
  236.     textR.positiveText  := posText;             (* links *)
  237.     textR.negativeText  := negText;             (* rechts *)
  238.     textR.title         := header;              (* FensterTitel *)
  239.     textR.keyMask       := {0..15};
  240.     textR.textcolor     := 1;
  241.     textR.detailcolor   := 0;
  242.     textR.blockcolor    := 0;
  243.     textR.versionnumber := 0;
  244.     textR.rfu1          := 0;
  245.     textR.rfu2          := 0;
  246.     result:=rl.TextRequest(ADR(textR));
  247.     RETURN(result);
  248.  END Request;
  249.  
  250.  
  251. PROCEDURE ThreeGadRequest(header,body,posText,midText,negText:
  252.                           ARRAY OF CHAR): INTEGER ;
  253.  BEGIN
  254.     RETURN Request(ADR(header),ADR(body),ADR(posText),ADR(midText),
  255.                    ADR(negText)) ;
  256.  END ThreeGadRequest ;
  257.  
  258.  
  259. PROCEDURE SimpleRequest(header,body,posText : ARRAY OF CHAR);
  260.  
  261.  BEGIN
  262.     result := Request(ADR(header),ADR(body),ADR(posText),NIL,NIL);
  263.  END SimpleRequest;
  264.  
  265.  
  266. PROCEDURE DeadEndExit(header,body,posText: ARRAY OF CHAR) ;
  267.  
  268.  BEGIN
  269.     result := Request(ADR(header),ADR(body),ADR(posText),NIL,NIL)  ;
  270.     Terminate ;
  271.  END DeadEndExit ;
  272.  
  273.  
  274. PROCEDURE TwoGadRequest(header,body,posText,negText : ARRAY OF CHAR):
  275.                         BOOLEAN;
  276.  
  277.  BEGIN
  278.     result := Request(ADR(header),ADR(body),ADR(posText),NIL,ADR(negText));
  279.     IF result = 1 THEN
  280.        RETURN TRUE
  281.     ELSE
  282.        RETURN FALSE
  283.     END ;
  284.  END TwoGadRequest;
  285.  
  286.  
  287. END ReqSupport.
  288.